COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00005 00003
C00008 00004
C00012 00005
C00023 ENDMK
C⊗;

;;;   **************************************************************
TITLE ***** MACLISP ****** MIDAS OP-DECODER (GETMIDASOP) ***********
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


.FASL

IF1,[

IFE .OSMIDAS-<SIXBIT \ITS\>,[
IFNDEF D10, D10==0
IFNDEF ITS,[
IFE D10, ITS==1
.ELSE ITS==0
]
DEFINE $INSRT $%$%$%
	.INSRT $%$%$% >
	PRINTX \    ==> INSERTED:  \
	$FNAME .IFNM1
	PRINTX \ \
	$FNAME .IFNM2
PRINTX \
\
TERMIN
]		;END OF IFE .OSMIDAS-<SIXBIT \ITS\>,
IFE .OSMIDAS-<SIXBIT \DEC\>,[
IFNDEF D10, D10==1
IFNDEF ITS,[
IFE D10, ITS==1
.ELSE ITS==0
]
DEFINE $INSRT $%$%$%
	.INSRT $%$%$%!.MID
	PRINTX \INSERTED:  \
	$FNAME .IFNM1
	PRINTX \.\
	$FNAME .IFNM2
PRINTX \
\
TERMIN
]		;END OF IFE .OSMIDAS-<SIXBIT \DEC\>,

IFNDEF $INSRT, .FATAL SO WHAT KIND OF OPERATING SYSTEM IS THIS ANYWAY???

DEFINE $FNAME FOO	;PRINTX A FILE NAME GIVEN NUMERIC SIXBIT
ZZX==<FOO>
REPEAT 6,[
IRPNC ZZX←-36,1,1,Q,,[ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ(\)↑←]
IFSN [Q][ ]	PRINTX |Q|
TERMIN
ZZX==ZZX←6
]
TERMIN

$INSRT DEFNS

]		;END OF IF1

IFN ITS+D10-1,[
	INFORM [
	ITS=]\ITS,[  D10=]\D10
	 .FATAL ITS AND D10 SWITCHES NOT CONSISTENT
]	;END OF IFN ITS+D10-1

IFN D10,[
 PRINTX \ASSEMBLING TOPS10 OP DECODER
\
]
IFN ITS,[
 PRINTX \ASSEMBLING ITS OP DECODER
\
]

VERPRT GETMIDASOP


.ENTRY GETMIDASOP SUBR 2	;THIS SAYS "1 ARG"

GETMIDASOP:
	PUSH FXP,[0]		;SIXBIT IN R, SQUOZE ON  0(FXP)
	PUSH P,A		;THIS PUSH PURELY FOR GC PROTECTION DURING SQOZ|
	HRLZS A			;A PSEUDO NCONS ON THE ARG
	PUSH P,A
	MOVEI A,(P)
	NCALL 1, .FUNCTION SQOZ|
	MOVEM TT,(FXP)
	SUB P,[2,,2]
	SETZB A,D			;NOTE THAT A HAS NIL UNTIL FURTHER NOTICE
	LSHC D,6			;D GETS FIRST CHARACTER
10%	CAIN D,'.			;IS FIRST CHAR OF SYMBOL A .?
10%	JRST GTMOP1			;IF NOT, TRY SEARCHING MOBY OPCODE TABLE FOR IT
	SETZB TT,AR2A			;TT HOLDS BINARY OPCODE, AR2A HOLDS TABLE INDEX
	CAIL D,'L			;IF IT'S L OR HIGHER, LET'S SAVE TIME
	MOVEI AR2A,OPTBLL-OPTABL	; BY STARTING HALFWAY DOWN THE FIRST LIST
GTMOP2:	LDB T,[271400,,OPTABL(AR2A)]	;GET CHAR(S) FROM TABLE ENTRY
	CAIN D,(T)			;COMPARE TO CHAR(S) FROM SIXBIT SYMBOL
	JRST GTMOP3			;A MATCH!
	SKIPL OPTABL(AR2A)		;SKIP IF LAST ENTRY IN TABLE
	AOJA AR2A,GTMOP2		;ELSE TRY NEXT ENTRY
GMXIT:	SUB FXP,[1,,1]
	POPJ P,				;LOSE - A STILL HAS NIL
GTMOP3:	ADD TT,OPTABL(AR2A)		;ADD OPCODE MODIFIER TO RUNNING SUM (EXTRA BITS DON'T HURT)
	LDB T,[220400,,OPTABL(AR2A)]	;HOW MANY CHARS SHALL WE CHECK NEXT?
	JUMPE T,GTMOP4			;NONE - END OF THE TREE BRANCH
	SETZ D,
	LSHC D,(T)			;1 OR 2 CHARS - PUT THEM IN D
	LDB AR2A,[111100,,OPTABL(AR2A)]	;PUT POINTER TO NEXT LIST IN AR2A
	JRST GTMOP2			;CONTINUE MOBY SEARCH
GTMOP4:	JUMPN R,GMXIT			;REST OF SIXBIT SHOULD BE ZERO - ELSE LOSE (A STILL HAS NIL)
	LSH TT,33			;SHIFT 9 BIT OPCODE TO TOP OF WORD
GMXT1:	JSP T,FIX1A"			;RETURN AS NUMERIC VALUE (HOORAY!)
	JRST GMXIT

IFE D10,[
GTMOP1:	.EVAL TT,			;TRY GETTING SYM VAL FROM ITS SYSTEM
	JRST GMXIT			;LOSE - A HAS NIL
	JRST GMXT1			;WIN - VALUE IS IN TT
]		;END OF IFE D10




;;; THE FOLLOWING TABLE IS FOR USE BY THE GETMIDASOP ROUTINE IN DECODING PDP-10
;;; OPCODES. IT CONTAINS REPRESENTATIONS FOR ALL STANDARD PDP-10 OPCODE
;;; SYMBOLS, AS WELL AS THE LISP UUO'S LERR, LER2, LER3, LER4, ERINT, AND STRT.
;;; THE TABLE IS IN THE FORM OF A SET OF LISTS WHICH ARE LINKED TO ONE ANOTHER
;;; TO FORM A TREE. EACH LIST ENTRY IS ONE WORD IN THE FOLLOWING FORMAT:
;;; 	BIT  4.9	IF 1, INDICATES THE LAST ENTRY OF THE LIST
;;; 	BITS 4.3-4.8	FIRST OF TWO SIXBIT CHARS TO COMPARE
;;; 	BITS 3.6-4.2	SECOND OR ONLY SIXBIT CHAR TO COMPARE
;;; 	BIT  3.5	UNUSED
;;; 	BITS 3.1-3.4	6*<NUMBER OF CHARS IN ENTRIES IN NEXT LIST>
;;; 			ZERO IF THERE IS NO NEXT LIST - IMPLIES REST OF
;;; 			SYMBOL MUST BE BLANK
;;; 	BITS 2.1-2.9	OFFSET FROM BEGINNING OF TABLE POINTING TO NEXT
;;; 			LIST TO USE TO CONTINUE THE COMPARISON
;;; 	BITS 1.1-1.9	VALUE TO BE ADDED TO A RUNNING SUM TO PRODUCE
;;; 			THE BINARY OPCODE
;;; THE TREE IS TRACED BY BEGINNING WITH THE LIST STARTING AT LOCATION
;;; OPTABL. AT EACH STEP ONE THEN SCANS THE CURRENT LIST, COMPARING THE
;;; NEXT ONE OR TWO CHARACTERS OF THE SYMBOL TO THOSE IN THE TABLE.
;;; IF NO MATCH IS FOUND, THE SYMBOL IS NOT IN THE TBALE. IF A MATCH IS
;;; FOUND, BITS 1.1-1.9 ARE ADDED TO A RUNNING SUM, BITS 2.1-2.9 POINT
;;; TO THE NEXT LIST TO SCAN, AND BITS 3.1-3.4 INDICATE HOW MANY CHARACTERS
;;; OF THE SYMBOL TO COMPARE TO THAT TABLE. IF BITS 3.1-3.4 ARE ZERO,
;;; THEN IF THERE REMAIN NON-BLANK CHARACTERS IN THE SYMBOL, THE SYMBOL
;;; IS NOT IN THE TABLE; IF THE REST OF THE SYMBOL IS BLANK, THEN THE
;;; RUNNING SUM IS THE FINAL 9 BIT BINARY OPCODE.

DEFINE OP CHARS,OFFSET,OPVAL,LASTP	;CREATE LIST ENTRY FOR OPCODE TABLE
ZZZ==0
IRPC X,,[CHARS]
IFSE X,-, ZZZ==ZZZ←6
IFSN X,-, ZZZ==ZZZ←6+'X
TERMIN
IFSN LASTP,, ZZZ==ZZZ+11←14
	<OFFSET>+<OPVAL>+ZZZ←27
TERMIN

DEFINE OPTB NAME,N		;CREATE SYMBOL TO USE AS SECOND ARG TO OP MACRO
IRPS Q,,[NAME]
Q==<.-OPTABL>←11(6*N)
TERMIN
TERMIN

.XCREF OP OPTB
;;; FOR THE DECSYSTEM-10 VERSION, THE FOLLOWING UUO'S ARE
;;; DEFINED IN ADDITION TO LISP UUO'S AND PDP-10 OPCODES.
;;; WARNING! THE VALUE SUPPLIED FOR THE SYMBOL "CALL" IS
;;; THAT FOR THE LISP UUO, NOT FOR THE DECSYSTEM-10 UUO!
;;;	CALLI	47	MTAPE	72	STATO	61
;;;	CLOSE	70	OPEN	50	STATZ	63
;;;	ENTER	77	OUT	57	TTCALL	51
;;;	GETSTS	62	OUTBUF	65	UGETF	73
;;;	IN	56	OUTPUT	67	USETI	74
;;;	INBUF	64	RELEASE	71	USETO	75
;;;	INPUT	66	RENAME	55
;;;	LOOKUP	76	SETSTS	60



OPTABL:	OP A,OP.A		;INITIAL LETTERS FOR
	OP B,OP.B		; ALL INSTRUCTIONS
	OP C,OP.C
	OP D,OP.D
	OP E,OP.E
	OP F,OP.F
10$	OP G,OP.G
	OP H,OP.H
	OP I,OP.I
	OP J,OP.J,,*
OPTBLL:	OP L,OP.L		;THIS LIST IS IN TWO 
	OP M,OP.M		; HALVES FOR SPEED
	OP N,OP.N
	OP O,OP.O		; IN SEARCHING
	OP P,OP.P
	OP R,OP.R
	OP S,OP.S
	OP T,OP.T
	OP U,OP.U
	OP X,OP.X,,*

OPTB OP.A:,2
	OP DD,OP.IMB,270	;ADD--
	OP ND,OP.AND,404	;AND--
	OP OB,OP.AOB,252	;AOBJP, AOBJN
	OP OJ,OP.CND,340	;AOJ--
	OP OS,OP.CND,350	;AOS--
	OP SH,OP.SHF,240	;ASH, ASHC
	OP CA,OP.%LL,002	;CALL, CALLF
	OP JC,OP.AJC,003,*	;AJCALL

OPTB OP.B:,2
	OP LT,,251,*		;BLT

OPTB OP.C:,2
	OP AI,OP.CND,300	;CAI--
	OP AM,OP.CND,310	;CAM--
10%	OP IR,OP.CIR,243	;CIRC (AI-ITS ONLY)
10$	OP LO,OP.%SE,070	;CLOSE (D10 ONLY)
	OP AL,OP.CAL,,*		;CALL, CALLF; CALLI (D10 ONLY)

OPTB OP.D:,2
	OP IV,OP.IMB,234	;DIV--
	OP PB,,137		;DPB
	OP FN,,131,*		;DFN

OPTB OP.E:,2
	OP QV,OP.IMB,444	;EQV--
	OP XC,OP.%%H,250	;EXCH
10$	OP NT,OP.%ER,077	;ENTER (D10 ONLY)
	OP RI,OP.%NT,005,*	;ERINT

OPTB OP.F:,2
	OP AD,OP.FLT,140	;FAD--
	OP SB,OP.FLT,150	;FSB--
	OP MP,OP.FLT,160	;FMP--
	OP DV,OP.FLT,170	;FDV--
	OP SC,,132,*		;FSC

IFN D10,[
OPTB OP.G:,2
	OP ET,OP.STS,62,*	;GETSTS (D10 ONLY)
]		;END OF IFN D10

OPTB OP.H:,2
	OP LL,OP.ZOE,500	;HLL--
	OP RL,OP.ZOE,504	;HRL--
	OP RR,OP.ZOE,540	;HRR--
	OP LR,OP.ZOE,544,*	;HLR--

OPTB OP.I:,2
	OP OR,OP.IMB,434	;IOR--
	OP MU,OP.IMU,220	;IMUL--
	OP DI,OP.IDI,230	;IDIV--
	OP LD,OP.%%B,134	;ILDB
	OP DP,OP.%%B,136	;IDPB
10$	OP NB,OP.%UF,064	;INBUF (D10 ONLY)
10$	OP NP,OP.%UT,066	;INPUT (D10 ONLY)
10$	OP N-,,056		;IN (D10 ONLY)
	OP BP,,133,*		;IBP

OPTB OP.J:,2
	OP UM,OP.JSK,320	;JUMP--
	OP RS,OP.%%T,254	;JRST
	OP SR,,264		;JSR
	OP SP,,265		;JSP
	OP CA,OP.N%J,015	;JCALL, JCALLF
	OP FC,OP.%%L,255	;JFCL
	OP SA,,266		;JSA
	OP RA,,267		;JRA
	OP FF,OP.%%O,243,*	;JFFO

OPTB OP.L:,2
	OP SH,OP.SHF,242	;LSH, LSHC
	OP DB,,135		;LDB
10$	OP OO,OP.KUP,076	;LOOKUP (D10 ONLY)
	OP ER,OP.LER,,*		;LER--

OPTB OP.M:,2
	OP OV,OP.MOV,200	;MOV--
10$	OP TA,OP.%PE,072	;MTAPE (D10 ONLY)
	OP UL,OP.IMB,224,*	;MUL--

OPTB OP.N:,2
	OP CA,OP.N%J,20		;NCA---
	OP JC,OP.NJC,21,*	;NJC---

OPTB OP.O:,2
10$	OP PE,OP.%%N,050	;OPEN (D10 ONLY)
10$	OP UT,OP.OUT		;OUTPUT, OUTBUF (D10 ONLY)
	OP RC,OP.ORC,,*		;ORC--

OPTB OP.P:,2
	OP US,OP.PUS,260	;PUSHJ, PUSH
	OP OP,OP.POP,262,*	;POP, POPJ

OPTB OP.R:,2
10$	OP EL,OP.REL,071	;RELEAS (D10 ONLY)
10$	OP EN,OP.REN,055	;RENAME (D10 ONLY)
	OP OT,OP.SHF,241,*	;ROT, ROTC

OPTB OP.S:,2
	OP KI,OP.JSK,330	;SKIP--
	OP UB,OP.IMB,274	;SUB--
	OP OJ,OP.CND,360	;SOJ--
	OP OS,OP.CND,370	;SOS--
	OP ET,OP.SET,400	;SET--
	OP ER,OP.SER,010	;SERINT
10$	OP ET,OP.STS,60		;SETSTS (D10 ONLY)
10$	OP TA,OP.STA		;STATO, STATZ (D10 ONLY)
	OP TR,OP.%%T,007,*	;STRT

OPTB OP.T:,1
10$	OP T,OP.TT,051	;TTYCAL (D10 ONLY)
	OP R,OP.ZCO,600		;TR--
	OP L,OP.ZCO,601		;TL--
	OP D,OP.ZCO,610		;TD--
	OP S,OP.ZCO,611,*	;TS--

OPTB OP.U:,2
10$	OP GE,OP.UGE		;UGETF (D10 ONLY)
10$	OP SE,OP.USE		;USETI, USETO (D10 ONLY)
	OP FA,,130,*		;UFA

OPTB OP.X:,2
	OP OR,OP.IMB,430	;XOR--
	OP CT,,256,*		;XCT

OPTB OP.AND:,1
	OP C,OP.NDC,4		;ANDC--
OPTB OP.IMB:,1			;ADDRESSING MODES
	OP -,,0			; NORMAL
	OP I,,1			; IMMEDIATE
	OP M,,2			; MEMORY
	OP B,,3,*		; BOTH

OPTB OP.AOB:,2
	OP JP,,0		;AOBJP
	OP JN,,1,*		;AOBJN

OPTB OP.CND:,2			;CONDITION MODIFIERS
	OP L-,,1		; LESS
	OP LE,,3		; LESS OR EQUAL
	OP GE,,5		; GREATER OR EQUAL
	OP G-,,7		; GREATER
OPTB OP.EAN:,2			;CONDITIONS FOR TEST INSTRUCTIONS
	OP --,,0		; NEVER
	OP E-,,2		; EQUAL
	OP A-,,4		; ALWAYS
	OP N-,,6,*		; NOT EQUAL

OPTB OP.SHF:,1			;SHIFT MODIFIERS
	OP -,,0			; ASH, ROT, LSH
OPTB OP.CIR:,1
	OP C,,4,*		; ASHC, ROTC, LSHC, CIRC

OPTB OP.CAL:,1
	OP L,OP.CLX,014,*	;CALL, CALLF

OPTB OP.N%J:,2
	OP LL,OP.CLY,,*

OPTB OP.CLX:,1
10$	OP I,,033		;CALLI (D10 ONLY)
OPTB OP.CLY:,1
	OP -,,0			;CALL, JCALL, NCALL
	OP F,,2,*		;CALLF, JCALLF, NCALLF

OPTB OP.NJC:,2
	OP AL,OP.NJ1,,*
OPTB OP.NJ1:,1
	OP F,,2			;NJCALF
OPTB OP.%%L:,1
	OP L,,0,*		;NJCALL
OPTB OP.%LL:,2
	OP LL,,0,*		;ACALL  (AND TTCALL IN D10)
OPTB OP.AJC,1
	OP A,OP.%LL,,*		;AJCALL

OPTB OP.FLT:,1			;FLOATING MODIFIERS
	OP R,OP.IMB,4		; ROUNDED
	OP -,,0			; NORMAL
	OP L,,1			; LONG
	OP M,,2			; MEMORY
	OP B,,3,*		; BOTH

OPTB OP.ZOE:,1			;HALFWORD MODIFIERS
	OP Z,OP.IMS,10		; ZEROS
	OP O,OP.IMS,20		; ONES
	OP E,OP.IMS,30		; EXTEND
OPTB OP.IMS:,1			;ADDRESSING MODES
	OP -,,0			; NORMAL
	OP I,,1			; IMMEDIATE
	OP M,,2			; MEMORY
	OP S,,3,*		; SELF

OPTB OP.IMU:,1
	OP L,OP.IMB,,*		;IMUL--

OPTB OP.IDI:,1
	OP V,OP.IMB,,*		;IDIV--

OPTB OP.JSK:,1
	OP P,OP.CND,,*		;JUMP--, SKIP--

OPTB OP.LER:,1			;LISP ERROR UUO TYPES
	OP R,,001		; LERR
	OP 3,,004		; LER3

OPTB OP.MOV:,1			;MOVE MODIFIERS
	OP E,OP.IMS,0		; MOVE--
	OP S,OP.IMS,4		; MOVS--
	OP N,OP.IMS,10		; MOVN--
	OP M,OP.IMS,14,*	; MOVM--

OPTB OP.ORC:,1
	OP A,OP.IMB,454		;ORCA--
	OP M,OP.IMB,464		;ORCM--
	OP B,OP.IMB,470,*	;ORCB--

OPTB OP.PUS:,2
	OP HJ,,0		;PUSHJ
	OP H-,,1,*		;PUSH

OPTB OP.POP:,1
	OP -,,0			;POP
	OP J,,1,*		;POPJ

OPTB OP.SET:,1
	OP Z,OP.IMB,0		;SETZ--
	OP O,OP.IMB,74		;SETO--
	OP A,OP.IMB,24		;SETA--
	OP M,OP.IMB,14		;SETM--
	OP C,OP.STC,50,*	;SETC--

OPTB OP.NDC:,1
	OP B,OP.IMB,30		;ANDCB--
OPTB OP.STC:,1
	OP A,OP.IMB,0		;ANDCA--, SETCA--
	OP M,OP.IMB,10,*	;ANDCM--, SETCM--

OPTB OP.ZCO:,1			;TEST MODIFIERS
	OP N,OP.EAN,0		; NO CHANGE
	OP Z,OP.EAN,20		; ZEROS
	OP C,OP.EAN,40		; COMPLEMENT
	OP O,OP.EAN,60,*	; ONES

OPTB OP.SER:,1
	OP I,OP.%NT,0,*		;SERI--

OPTB OP.%%H:,1
	OP H,,0,*		;EXCH

OPTB OP.%NT:,2
	OP NT,,0,*		;ERINT, SERINT

OPTB OP.%%B:,1
	OP B,,0,*		;ILDB, IDPB

OPTB OP.%%T:,1
	OP T,,0,*		;JRST, STRT

OPTB OP.%%O:,1
	OP O,,0,*		;JFFO



IFN D10,[		;MANY ENTRIES JUST FOR DECSYSTEM-10
OPTB OP.UGE:,2
	OP TF,,073,*		;UGETF
OPTB OP.USE:,2
	OP TI,,074		;USETI
	OP TO,,075,*		;USETO
OPTB OP.STA:,2
	OP TO,,061		;STATO
	OP TZ,,063,*		;STATZ
OPTB OP.OUT:,1
	OP -,,057		;OUT
	OP B,OP.%UF,065		;OUTBUF
	OP P,OP.%UT,067,*	;OUTPUT
OPTB OP.REL:,2
	OP EA,OP.%%S,,*		;RELEAS
OPTB OP.REN:,2
	OP AM,OP.%%E,,*		;RENAME
OPTB OP.TT:,2
	OP CA,OP.%LL,,*		;TTCALL
OPTB OP.STS:,2
	OP ST,OP.%%S,,*		;GETSTS, SETSTS
OPTB OP.%SE:,2
	OP SE,,0,*		;CLOSE
OPTB OP.%%N:,1
	OP N,,0,*		;OPEN
OPTB OP.%ER:,2
	OP ER,,0,*		;ENTER
OPTB OP.%UF:,2
	OP UF,,0,*		;INBUF, OUTBUF
OPTB OP.%UT:,2
	OP UT,,0,*		;INPUT, OUTPUT
OPTB OP.%%P:,1
	OP P,,0,*		;LOOKUP
OPTB OP.KUP:,2
	OP KU,OP.%%P,,*		;LOOKUP
OPTB OP.%PE:,2
	OP PE,,0,*		;MTAPE
OPTB OP.%%S:,1
	OP S,,0,*		;RELEAS
OPTB OP.%%E:,1
	OP E,,0,*		;RENAME
]		;END OF IFN D10


;;; OPCODE TABLE MUST HAVE LESS THAN 1000 ENTRIES
IFL OPTABL+1000-.,[
	.ERR ######
	PRINTX \OPCODE TABLE TOO BIG - LENGTH =\
	INFORM \.-OPTABL
]

END